home *** CD-ROM | disk | FTP | other *** search
/ ASP Advantage 1993 / The Association of Shareware Professionals Advantage CD-ROM 1993.iso / files / commions / ca29_1 / ca29_3.exe / REMAP.CMD < prev    next >
OS/2 REXX Batch file  |  1992-03-23  |  28KB  |  1,165 lines
  1.    S29 = "INTERNAL"                     ; Set your editor here
  2. ;                    ; .. "INTERNAL" -> Our own editor
  3. ; ----- COM-AND Compile remap table
  4. ;
  5. ;    This script opens a window asking 1) to compile new remap, 2) turn
  6. ;    remapping on, and 3) turn remap off.
  7. ;
  8. ;    The big job, of course, if the compilation of remapping values.
  9. ;    The result of the compilation is saved unconditionally as COM-AND.RMP.
  10. ;
  11. ;    R.McG, commenced 2/89
  12. ;           updated     3/92 (to use internal editor)
  13. ; ----- Usages -----------------
  14. ;    S29 -----> The fully qualified EDITOR program file name
  15. ;    S19 -----> COM-AND.RMP file name to be used
  16. ;    S18 -----> Source file being compiled
  17. ;    N99 -----> The # of errors in compilation
  18. ;    N98 -----> The output file size
  19. ;    N97 -----> # name commands to allow (set in SELECT)
  20. ;    FLAG(9) -> Escape during compile (wait for another ESC)
  21. ;    FLAG(8) -> If true, syntax check only
  22. ; ------------------------------
  23. ;    Initialization
  24. ;
  25. ;* TRACE ON
  26.    ON ESCAPE GOSUB Exit         ; SAVE is performed in Window
  27.    LEGEND " Remap compiler (ver 1.2)"
  28.    SET TTHRU OFF            ; Disallow typeahead
  29.    GOSUB Set_Fname            ; Get current fname
  30.    UPPER S19                ; Make nice for display
  31. ;
  32. ;    Open a window
  33. ;
  34.    GOSUB Window             ; Open main window
  35. ;
  36. ;    Wait for a keystroke
  37. ;
  38. Keyin:
  39.    LOCATE 18,20
  40.    ATSAY  18,20 (default) "   "
  41.    KEYGET S0
  42.    IF NULL S0(1:3)
  43.       ATSAY 18,20 (default) S0
  44.       ENDIF
  45. ;
  46. ;    Interpret the response
  47. ;
  48.    SWITCH S0
  49.       CASE "1"                                  ; Compile
  50.     GOSUB Compile
  51.       ENDCASE
  52.       CASE "2"                                  ; Syntax
  53.     GOSUB Syntax
  54.       ENDCASE
  55.       CASE "3"                                  ; Search for file
  56.     GOSUB Alt_F
  57.       ENDCASE
  58.       CASE "4"                                  ; Edit a file
  59.     GOSUB Edit
  60.       ENDCASE
  61.       CASE "5"                                  ; Remap on
  62.     GOSUB Mapon
  63.       ENDCASE
  64.       CASE "6"                                  ; Remap off
  65.     GOSUB Mapoff
  66.       ENDCASE
  67.       DEFAULT                    ; None of the above
  68.      SOUND 100,100
  69.      GOTO Keyin                ; Try again
  70.       ENDCASE
  71.    ENDSWITCH
  72.    GOTO KEYIN
  73. ;
  74. ; ----- Subroutine Exit - terminate the process
  75. ;
  76. Exit:
  77.     DO                ; CLose any open windows
  78.       WCLOSE
  79.       UNTIL FAILURE
  80.     EXIT
  81. ;
  82. ; ----- Subroutine Mapon - turn on mapping (using current file)
  83. ;
  84. MapOn:
  85.     SET REMAP ON            ; Enable
  86.     RETURN
  87. ;
  88. ; ----- Subroutine MapOff - turn off mapping
  89. ;
  90. MapOff:
  91.     SET REMAP OFF            ; Disable
  92.     RETURN
  93. ;
  94. ; ----- Perform an Alt-F - file search
  95. ;
  96. Alt_F:
  97.     WOPEN 10,1  13,78 (default) ErrEsc
  98.     ATSAY 10,3  (default) " Search for files "
  99.     ATSAY 11,3  (default) "Enter a search template (e.g. 'd:\subd\x*.AR?')."
  100.     ATSAY 12,3  (default) "-> "
  101.     ATSAY 13,30 (default) " Press ESC to cancel "
  102.     ATGET 12,6  (default) 50 S0
  103.     WCLOSE
  104. ;
  105. ;    If not null, perform the request
  106. ;
  107.     IF NOT NULL S0
  108.        DIR S0                ; Make upper case
  109.        ENDIF
  110.     RETURN
  111. ;
  112. ; ----- Invoke an editor to edit a file
  113. ;
  114. Edit:
  115.     IF NOT NULL S29 GOTO Edit100
  116. ;
  117. ;    Open a window and ask for the editor's name
  118. ;
  119.     WOPEN 10,1  13,78 (default) ErrEsc
  120.     ATSAY 10,3  (default) " Edit file "
  121.     ATSAY 11,3  (default) "Enter the editor's name, fully qualified (e.g. C:\PE.EXE)."
  122.     ATSAY 12,3  (default) "-> "
  123.     ATSAY 13,30 (default) " Press ESC to cancel "
  124.     ATGET 12,6  (default) 50 S0        ; ErrEsc clears S0, so we use it
  125.     WCLOSE
  126.  
  127.     IF NULL S0 RETURN            ; Return on empty answer
  128.     S29 = S0                ; Save for next time
  129. ;
  130. ;    Open another window and ask for the file name
  131. ;
  132. Edit100:
  133.     WOPEN 10,1  13,78 (default) ErrEsc
  134.     ATSAY 10,3  (default) " Edit file "
  135.     ATSAY 11,3  (default) "Enter the file name to be edited:"
  136.     ATSAY 12,3  (default) "-> "
  137.     ATSAY 13,30 (default) " Press ESC to cancel "
  138.     ATGET 12,6  (default) 50 S0        ; ErrEsc clears S0, so we use it
  139.     WCLOSE
  140. ;
  141. ;    If not null, perform the request
  142. ;
  143.     IF NOT NULL S0 and (NOT NULL S29 and NOT FIND S29 "INTERNAL")
  144.        RUN S29 * " " *S0                    ; Make upper case
  145.        IF FAILED S29 = "INTERNAL"           ; Clear S29 if failed
  146.        ENDIF
  147.     IF (NULL S29 or FIND S29 "INTERNAL") and NOT NULL S0 EDIT S0
  148.     RETURN
  149. ;
  150. ; ----- Construct the file name we'll use for COM-AND.RMP
  151. ;
  152. Set_Fname:
  153.     S19 = "COM-AND.RMP"     ; Default to current subdir
  154.     IF ISFILE S19        ; Look for file on default subdir
  155.        RETURN        ; Exit here
  156.        ENDIF
  157. ;
  158. ; ----- Construct the file with the COM-AND= pathing (if provided)
  159. ;
  160.     ENVIRON S1 "COM-AND="   ; Look for COM-AND= environment var
  161.     IF FOUND        ; If environment variable found
  162.        LENGTH S1 N0     ; Get its length
  163.        N0 = N0-1        ; Point to last char in string
  164.        IF not STRCMP S1(n0:n0) "\"
  165.           N0 = N0+1
  166.           CONCAT S1(n0) "\"
  167.           ENDIF
  168.        ENDIF
  169.     S19 = S1&"COM-AND.RMP"  ; Concatenate path and name
  170.     RETURN
  171. ;
  172. ; ----- Subroutine: error
  173. ;    .. Open a window, display, and and await keypress
  174. ;    S0,S1 pass the message(s) to display
  175. ;
  176. Error:
  177.     WOPEN 10,1, 13,77 (contrast) ErrEsc
  178.     ATSAY 11, 3 (contrast) S0(0:73)
  179.     ATSAY 12, 3 (contrast) S1(0:73)
  180.     ATSAY 13,26 (contrast) " Press any key to continue "
  181.     SOUND 880,100
  182.  
  183.     KEYGET S0        ; Wait for any key
  184.     WCLOSE            ; Restore screen under
  185.     RETURN            ; And return to caller
  186. ;
  187. ;    Escape during "Error" window
  188. ;
  189. ErrEsc:
  190.     S0 = ""                 ; Make S0 null
  191.     RETURN            ; And return to KEYGET above
  192. ;
  193. ; ----- Subroutine: Test S0 for a valid (known) keycode
  194. ;    Parameter S0 ------> The keycode being passed
  195. ;    Return:   FLAG(0) <- TRUE if erroneous keycode
  196. ;          S0 <------ The converted keycode (if FLAG(0) false)
  197. ;          N0 <------ The length of the converted keycode
  198. ;
  199. Keycode:
  200.     LJ S0            ; Force left justification
  201.     S0 = S0&""              ; Trim trailing blanks
  202.     SET FLAG(0) OFF     ; Default return value
  203.     LENGTH S0 N0        ; Compute len of parm
  204. ;
  205. ;    Catch decimal and hex numbers here
  206. ;
  207.     IF NUMERIC S0(0:0)    ; Case insensitive test here
  208.        ATOI S0 N0        ; Convert value
  209.        IF (NOT ERROR) and (GE N0 0 and LE N0 255)
  210.           ITOC N0 S0    ; Return value 0-255 as char
  211.           N0 = 1        ; Set rtn length
  212.           RETURN
  213.           ENDIF
  214.        ENDIF
  215. ;
  216. ;    Switch according to length here
  217. ;
  218.     SWITCH N0
  219.        CASE 1        ; 1 char wide
  220.          GOTO TEKE100
  221.        ENDCASE
  222.        CASE 2        ; 2 chars wide
  223.          GOTO TEKE200
  224.        ENDCASE
  225.        CASE 3        ; 3 chars wide
  226.          GOTO TEKE300
  227.        ENDCASE
  228.        CASE 4        ; 4 chars wide
  229.          GOTO TEKE400
  230.        ENDCASE
  231.        CASE 5        ; 5 chars wide
  232.          GOTO TEKE500
  233.        ENDCASE
  234.        CASE 6        ; 6 chars wide
  235.          GOTO TEKE600
  236.        ENDCASE
  237.        DEFAULT
  238.           SET FLAG(0) ON    ; Others are errors
  239.           RETURN
  240.        ENDCASE
  241.     ENDSWITCH
  242. ;
  243. ; ***** Single character keycode here (take char as-is)
  244. ;
  245. TEKE100:
  246.     N0 = 1            ; Return length here (char already in S0)
  247.     RETURN
  248. ;
  249. ; ***** Two character keycode here: First: ^chars
  250. ;
  251. TEKE200:
  252.     IF STRCMP S0(0:0) "^"   ; Caret initially
  253.        UPPER S0        ; Make upper case
  254.        CTOI S0(1:1) N0
  255.        ITOC (N0-64) S0    ; Convert to control form, and place
  256.        N0 = 1
  257.        RETURN
  258.        ENDIF
  259. ;
  260. ;    Catch F0-F9
  261. ;
  262.     IF FIND "F1,F2,F3,F4,F5,F6,F7,F8,F9" S0 N0
  263.        IF NE 0 (N0\3)    ; Modulo divide (remainder)
  264.           SET FLAG(0) ON    ; .. catch e.g. "0,"
  265.           RETURN
  266.           ENDIF
  267.        ITOC 0 S0
  268.        ITOC (0x3b+N0/3) S0(1)
  269.        N0 = 2
  270.        RETURN
  271.        ENDIF
  272. ;
  273. ;    Catch cr and bs here
  274. ;
  275.     SWITCH S0
  276.        CASE "CR"            ; Carriage Rtn
  277.           ITOC 13 S0
  278.           N0 = 1
  279.           RETURN
  280.        ENDCASE
  281.        CASE "BS"            ; Carriage Rtn
  282.           ITOC 8 S0
  283.           N0 = 1
  284.           RETURN
  285.        ENDCASE
  286.     ENDSWITCH
  287. ;
  288. ;    Other pairs are errors
  289. ;
  290.     SET FLAG(0) ON        ; Others are errors
  291.     RETURN
  292. ;
  293. ; ***** Three character keycode here: First, rtn a quoted character
  294. ;
  295. TEKE300:
  296.     IF STRCMP S0(0:0) "`"" and STRCMP S0(2:2) "`""
  297.        S0 = S0(1:1)
  298.        N0 = 1        ; Return length here (char in S0)
  299.        RETURN
  300.        ENDIF
  301. ;
  302. ;    Catch SF0-SF9, CF0-CF9, AF0-AF9, ^F0-^F9
  303. ;
  304.     UPPER S0
  305.     IF FIND "F1,F2,F3,F4,F5,F6,F7,F8,F9" S0(1:2) N0
  306.        IF NE (N0\3) 0    ; Modulo divide (remainder)
  307.           SET FLAG(0) ON    ; .. catch e.g. "0,"
  308.           RETURN
  309.           ENDIF
  310.     ;
  311.     ;    Look at the leading character
  312.     ;
  313.        FIND "SCA^" S0(0:0) N1
  314.        SWITCH N1
  315.           CASE 0        ; AF0,AF1...
  316.         ITOC (0x54+N0/3) S0(1)
  317.           ENDCASE
  318.           CASE 1        ; CF0,CF1...
  319.         ITOC (0x5E+N0/3) S0(1)
  320.           ENDCASE
  321.           CASE 2        ; AF0,AF1...
  322.         ITOC (0x68+N0/3) S0(1)
  323.           ENDCASE
  324.           CASE 3        ; ^F0,^F1...
  325.         ITOC (0x5E+N0/3) S0(1)
  326.           ENDCASE
  327.           DEFAULT
  328.         SET FLAG(0) ON
  329.         RETURN
  330.           ENDCASE
  331.        ENDSWITCH
  332.     ;
  333.     ;    Return with the goods
  334.     ;
  335.        ITOC 0 S0        ; Modify S) after look for "SCA^"
  336.        N0 = 2
  337.        RETURN
  338.        ENDIF
  339. ;
  340. ;    And finally, 'END','ESC', 'TAB' and 'F10'
  341. ;
  342.     SWITCH S0
  343.        CASE "END"           ; Endkey
  344.           ITOC 0x4f S0(1)
  345.           ITOC 0 S0
  346.           N0 = 2
  347.           RETURN
  348.        ENDCASE
  349.        CASE "TAB"           ; Tabkey
  350.           ITOC 9 S0
  351.           N0 = 1
  352.           RETURN
  353.        ENDCASE
  354.        CASE "ESC"           ; Esckey
  355.           ITOC 0x1b S0
  356.           N0 = 1
  357.           RETURN
  358.        ENDCASE
  359.        CASE "F10"           ; F10 key
  360.           ITOC 0x44 S0(1)
  361.           ITOC 0 S0
  362.           N0 = 2
  363.           RETURN
  364.        ENDCASE
  365.        CASE "INS"           ; Inskey
  366.           ITOC 0x52 S0(1)
  367.           ITOC 0 S0
  368.           N0 = 2
  369.           RETURN
  370.        ENDCASE
  371.        CASE "DEL"           ; Delkey
  372.           ITOC 0x53 S0(1)
  373.           ITOC 0 S0
  374.           N0 = 2
  375.           RETURN
  376.        ENDCASE
  377.     ENDSWITCH
  378. ;
  379. ;    Others are errors
  380. ;
  381.     SET FLAG(0) ON        ; Others are errors
  382.     RETURN
  383. ;
  384. ; ***** Four character keycode here
  385. ;
  386. TEKE400:
  387. ;
  388. ;    Catch AltA-AltZ, Alt0-Alt9, Alt-
  389. ;
  390.     UPPER S0
  391.     IF FIND "ALT" S0(0:2)   ; Case insensitive test
  392.     ;
  393.     ;    Catch Alt'd QWERTYUIOP
  394.     ;
  395.        IF FIND "QWERTYUIOP" S0(3) N0
  396.           ITOC (0x10+N0) S0(1)
  397.           ITOC 0 S0
  398.           N0 = 2
  399.           RETURN
  400.           ENDIF
  401.     ;
  402.     ;    Catch Alt'd ASDFGHJKL
  403.     ;
  404.        IF FIND "ASDFGHJKL" S0(3) N0
  405.           ITOC (0x1E+N0) S0(1)
  406.           ITOC 0 S0
  407.           N0 = 2
  408.           RETURN
  409.           ENDIF
  410.     ;
  411.     ;    Catch Alt'd ZXCVBNM
  412.     ;
  413.        IF FIND "ZXCVBNM" S0(3) N0
  414.           ITOC (0x2C+N0) S0(1)
  415.           ITOC 0 S0
  416.           N0 = 2
  417.           RETURN
  418.           ENDIF
  419.     ;
  420.     ;    Catch Alt'd 1234567890-
  421.     ;
  422.        IF FIND "1234567890-" S0(3) N0
  423.           ITOC (0x78+N0) S0(1)
  424.           ITOC 0 S0
  425.           N0 = 2
  426.           RETURN
  427.           ENDIF
  428.     ;
  429.     ;    Other Alt's are errors
  430.     ;
  431.        SET FLAG(0) ON
  432.        RETURN
  433.        ENDIF
  434. ;
  435. ;    Now, 'SF10', 'CF10' 'AF10' and '^F10'
  436. ;
  437.     IF FIND "F10" S0(1:3)           ; Last 3 chars are F10
  438.        FIND "SCA^" S0(0:0) N0
  439.        SWITCH N0
  440.           CASE 0        ; AF0,AF1...
  441.         ITOC 0x5D S0(1)
  442.           ENDCASE
  443.           CASE 1        ; CF0,CF1...
  444.         ITOC 0x67 S0(1)
  445.           ENDCASE
  446.           CASE 2        ; AF0,AF1...
  447.         ITOC 0x71 S0(1)
  448.           ENDCASE
  449.           CASE 3        ; ^F0,^F1...
  450.         ITOC 0x67 S0(1)
  451.           ENDCASE
  452.           DEFAULT
  453.         SET FLAG(0) ON
  454.         RETURN
  455.           ENDCASE
  456.        ENDSWITCH
  457.     ;
  458.     ;    Return with the goods
  459.     ;
  460.        ITOC 0 S0
  461.        N0 = 2
  462.        RETURN
  463.        ENDIF
  464. ;
  465. ;    Finally, Catch 'home', 'Pgup', 'PgDn', CURL', 'CURR', 'BELL' ,'^END'
  466. ;
  467.     SWITCH S0
  468.        CASE "^END"          ; Ctl-Endkey
  469.           ITOC 0x75 S0(1)
  470.           ITOC 0 S0
  471.           N0 = 2
  472.           RETURN
  473.        ENDCASE
  474.        CASE "HOME"          ; Homekey
  475.           ITOC 0x47 S0(1)
  476.           ITOC 0 S0
  477.           N0 = 2
  478.           RETURN
  479.        ENDCASE
  480.        CASE "PGUP"          ; PgDnkey
  481.           ITOC 0x49 S0(1)
  482.           ITOC 0 S0
  483.           N0 = 2
  484.           RETURN
  485.        ENDCASE
  486.        CASE "PGDN"          ; PgUpkey
  487.           ITOC 0x51 S0(1)
  488.           ITOC 0 S0
  489.           N0 = 2
  490.           RETURN
  491.        ENDCASE
  492.        CASE "CURL"          ; Cursor left
  493.           ITOC 0x4B S0(1)
  494.           ITOC 0 S0
  495.           N0 = 2
  496.           RETURN
  497.        ENDCASE
  498.        CASE "CURR"          ; Cursor right
  499.           ITOC 0x4D S0(1)
  500.           ITOC 0 S0
  501.           N0 = 2
  502.           RETURN
  503.        ENDCASE
  504.        CASE "BELL"          ; Bell char
  505.           ITOC 7 S0
  506.           N0 = 1
  507.           RETURN
  508.        ENDCASE
  509.        CASE "NULL"          ; Alt-NumKeyPad-0
  510.           ITOC 3 S0(1)
  511.           ITOC 0 S0
  512.           N0 = 2
  513.           RETURN
  514.        ENDCASE
  515.     ENDSWITCH
  516. ;
  517. ;    Others are errors
  518. ;
  519.     SET FLAG(0) ON        ; Others are errors
  520.     RETURN
  521. ;
  522. ; ***** Five character keycode here; First, catch AltF1-AltF9
  523. ;
  524. TEKE500:
  525.     UPPER S0
  526.     IF FIND "ALT" S0(0:2)   ; Case insensitive test
  527.        IF FIND "F1,F2,F3,F4,F5,F6,F7,F8,F9" S0(3:4) N0
  528.           IF NE (N0\3) 0       ; Modulo divide (remainder)
  529.          SET FLAG(0) ON    ; .. catch e.g. "0,"
  530.          RETURN
  531.          ENDIF
  532.           ITOC 0 S0
  533.           ITOC (0x68+N0/3) S0(1)
  534.           N0 = 2
  535.           RETURN
  536.           ENDIF
  537.     ;
  538.     ;     Catch AltEq here (syntax doesn't allow Alt=)
  539.     ;
  540.         IF FIND "EQ" S0(3:4)
  541.           ITOC 0 S0
  542.           ITOC (0x83+N0/3) S0(1)
  543.           N0 = 2
  544.           RETURN
  545.           ENDIF
  546.     ;
  547.     ;    Other Alt's are errors
  548.     ;
  549.        SET FLAG(0) ON
  550.        RETURN
  551.        ENDIF
  552. ;
  553. ;    Catch "^Home", "^PgUp", "^PgDn" "^CurR", "^CurL", "CurUp" and "CurDn"
  554. ;
  555.     SWITCH S0
  556.        CASE "^HOME"         ; Ctl-Homekey
  557.           ITOC 0x77 S0(1)
  558.           ITOC 0 S0
  559.           N0 = 2
  560.           RETURN
  561.        ENDCASE
  562.        CASE "^PGUP"         ; Ctl-PgDnkey
  563.           ITOC 0x84 S0(1)
  564.           ITOC 0 S0
  565.           N0 = 2
  566.           RETURN
  567.        ENDCASE
  568.        CASE "^PGDN"         ; Ctl-PgUpkey
  569.           ITOC 0x76 S0(1)
  570.           ITOC 0 S0
  571.           N0 = 2
  572.           RETURN
  573.        ENDCASE
  574.        CASE "^CURL"         ; Cursor left
  575.           ITOC 0x73 S0(1)
  576.           ITOC 0 S0
  577.           N0 = 2
  578.           RETURN
  579.        ENDCASE
  580.        CASE "^CURR"         ; Cursor right
  581.           ITOC 0x74 S0(1)
  582.           ITOC 0 S0
  583.           N0 = 2
  584.           RETURN
  585.        ENDCASE
  586.        CASE "CURDN"         ; Cursor down
  587.           ITOC 0x50 S0(1)
  588.           ITOC 0 S0
  589.           N0 = 2
  590.           RETURN
  591.        ENDCASE
  592.        CASE "CURUP"         ; Cursor up
  593.           ITOC 0x48 S0(1)
  594.           ITOC 0 S0
  595.           N0 = 2
  596.           RETURN
  597.        ENDCASE
  598.     ENDSWITCH
  599. ;
  600. ;    Others are errors
  601. ;
  602.     SET FLAG(0) ON        ; Others are errors
  603.     RETURN
  604. ;
  605. ; ***** Six character keycode here
  606. ;    .. Catch 'AltF10', '^PrtSc'
  607. ;
  608. TEKE600:
  609.     SWITCH S0
  610.        CASE "AltF10"        ; Alt'd F10
  611.           ITOC 0x71 S0(1)
  612.           ITOC 0 S0
  613.           N0 = 2
  614.           RETURN
  615.        ENDCASE
  616.        CASE "^PRTSC"        ; Ctl-PrtSc
  617.           ITOC 0x72 S0(1)
  618.           ITOC 0 S0
  619.           N0 = 2
  620.           RETURN
  621.        ENDCASE
  622.        CASE "RevTab"        ; Reverse tab
  623.           ITOC 0x0f S0(1)
  624.           ITOC 0 S0
  625.           N0 = 2
  626.           RETURN
  627.        ENDCASE
  628.     ENDSWITCH
  629. ;
  630. ;    Others are errors
  631. ;
  632.     SET FLAG(0) ON        ; Others are errors
  633.     RETURN
  634. ;
  635. ;    Escape during "compile" window
  636. ;    .. wait for a second esc
  637. ;
  638. CompEsc:
  639.     IF FLAG(9)
  640.        SET FLAG(9) OFF
  641.        RETURN
  642.        ENDIF
  643.     MESS "^M^JEsc pressed^M^JPress any key again to continue^M^J"
  644.     SET FLAG(9) ON
  645. Hang:
  646.     IF FLAG(9)
  647.        GOTO Hang
  648.        ENDIF
  649.     RETURN
  650. ;
  651. ; ----- Subroutine: Scan the input file for sections
  652. ;    If sections found, ask for a selection
  653. ;    Return:   FLAG(0) <- TRUE if use ESC'd
  654. ;          FLAG(0) <- FALSE -> File positioned for start
  655. ;          N97 -> THe number of "NAME" commands to pass by
  656. ;
  657. Select:
  658.     N97 = 1         ; Default one
  659.     N10 = 0         ; # of sections found
  660.     SET FLAG(1) OFF     ; F -> Nothing compilable preceding 1st section
  661.     WOPEN 10,1  12,78 (default) ErrEsc
  662.     ATSAY 10,3  (default) " Select section "
  663.     ATSAY 11,3  (default) "Scanning for sections in the source file..."
  664.     ATSAY 12,30 (default) " ESC ends script "
  665. ;
  666. ;    Save the current position, and read a line
  667. ;
  668. SELE100:
  669.     FSAVEI            ; Save current position
  670.     READ S0 80 N0        ; Len read into N0
  671.     IF EOF
  672.        FSAVEI POP        ; Throw away the EOF position
  673.        GOTO End_Select
  674.        ENDIF
  675. ;
  676. ;    Catch comments here (note save-stack pops)
  677. ;
  678.     IF NULL S0
  679.        FSAVEI POP        ; Throw away saved position
  680.        GOTO SELE100
  681.        ENDIF
  682.     LJ S0            ; Left justify
  683.     IF STRCMP S0(0:0) ";" or STRCMP S0(0:0) "*"
  684.        FSAVEI POP        ; Throw away saved position
  685.        GOTO SELE100
  686.        ENDIF
  687. ;
  688. ;    Extract the 1st field into S1
  689. ;
  690.     FIND S0 "=" N1          ; Find an '=' sign
  691.     S1 = S0(0:N1-1)     ; Extract keycode
  692.     LJ S1
  693.     IF EQ N1 0 or NULL S1    ; = in col 0, or empty keycode
  694.        FSAVEI POP        ; Throw away saved position
  695.        GOTO SELE100
  696.        ENDIF
  697. ;
  698. ;    The section heading, (NAME = ...) terminates I/O
  699. ;
  700.     IF NOT FIND S1(0:3) "NAME"  ; Case insensitive test
  701.        FSAVEI POP        ; Throw away saved position
  702.        IF ZERO N10        ; Not in a section
  703.           SET FLAG(1) ON    ; Mark a compilable line in unnamed section
  704.           ENDIF
  705.        GOTO SELE100     ; Skip if not section cmd
  706.        ENDIF
  707. ;
  708. ;    Extract the operand field
  709. ;
  710.     S2 = S0(N1+1:79)    ; Extract section name
  711.     LJ S2
  712. ;
  713. ;    We have found a section command - if the first - open a window
  714. ;
  715.     IF NOT ZERO N10     ; Test if already found a section
  716.        GOTO SELE200     ; SKip if window is open
  717.        ENDIF
  718.  
  719.     WCLOSE            ; Close open window (scanning...)
  720.     WOPEN 0 ,10 19,70 (default)
  721.     ATSAY 0 ,12 (default) " Remap Select "
  722.     ATSAY 1 ,11 (default)  " The source file contains multiple sections.  These are:   "
  723.     ATSAY 2 ,12 (default)  " 1)"
  724.     ATSAY 3 ,12 (default)  " 2)"
  725.     ATSAY 4 ,12 (default)  " 3)"
  726.     ATSAY 5 ,12 (default)  " 4)"
  727.     ATSAY 6 ,12 (default)  " 5)"
  728.     ATSAY 7 ,12 (default)  " 6)"
  729.     ATSAY 8 ,12 (default)  " 7)"
  730.     ATSAY 9 ,12 (default)  " 8)"
  731.     ATSAY 10,12 (default)  " 9)"
  732.     ATSAY 11,12 (default)  " 10)"
  733.     ATSAY 12,12 (default)  " 11)"
  734.     ATSAY 13,12 (default)  " 12)"
  735.     ATSAY 14,12 (default)  " 13)"
  736.     ATSAY 15,12 (default)  " 14)"
  737.     ATSAY 16,12 (default)  " 15)"
  738.     ATSAY 17,10 (default) "├───────────────────────────────────────────────────────────┤"
  739.     ATSAY 18,12 (default) "Select (1-10):"
  740.     ATSAY 19 32 (default) " Press ESC to exit "
  741. ;
  742. ;    If there's an initial unnamed section, name it
  743. ;
  744.     IF NOT FLAG(1)        ; If not compilable source before section...
  745.        GOTO SELE200     ; .. skip this
  746.        ENDIF
  747.     ATSAY N10+2,16 (default) "Unnamed 1st section"
  748.     INC N10
  749. ;
  750. ;    Add the section name to the list
  751. ;
  752. SELE200:
  753.     IF NULL S2
  754.        S2 = "Unnamed section #"&N10
  755.        ENDIF
  756.     ATSAY N10+2,16 (default) S2(0:48)
  757.     INC N10
  758.     IF LT N10 15        ; Allow up to 15 sections
  759.        GOTO SELE100
  760.        ENDIF
  761. ;
  762. ;    End of file scan - ask for a selection if there're sections
  763. ;
  764. End_Select:
  765.     IF ZERO N10 or EQ N10 1 ; No sections found or only one
  766.        REWIND        ; Rewind input file
  767.        SET FLAG(0) OFF    ; Return O-K
  768.        WCLOSE        ; Close 'scanning...' window
  769.        RETURN
  770.        ENDIF
  771. ;
  772. ;    Prompt for a selection
  773. ;
  774. ENSE100:
  775.     MESS "^G"
  776.     ATGET 18,27 (default) 2 S0
  777.     IF NULL S0
  778.        SET FLAG(0) ON
  779.        ENDIF
  780. ;
  781. ;    Interpret the response
  782. ;
  783.     ATOI S0 N0
  784.     IF LT N0 1 or GT N0 N10
  785.        SOUND 100,100
  786.        GOTO ENSE100
  787.        ENDIF
  788. ;
  789. ;    Use the selected # to pop the save stack
  790. ;
  791.     WCLOSE            ; Close 'select window'
  792.     WHILE LE N0 N10
  793.        FRESTOREI        ; Move back through saved positions
  794.        DEC N10        ; .. and decremnet index
  795.        ENDWHILE
  796.     IF EQ N0 1 and FLAG(1)    ; There was an unnamed section and we want it
  797.        REWIND        ; .. move to beginning of file
  798.        N97 = 0        ; Pass by no NAME commands
  799.        ENDIF
  800. ;
  801. ;    And return positioned OK
  802. ;
  803.     SET FLAG(0) OFF
  804.     FSAVEI CLEAR
  805.     RETURN
  806. ;
  807. ; ----- Subroutine Syntax check a source file
  808. ;
  809. Syntax:
  810.     SET FLAG(8) ON
  811.     GOTO Start
  812. ;
  813. ; ----- Subroutine Compile: compile a source file into COM-AND.RMP
  814. ;
  815. Compile:
  816.     SET FLAG(8) OFF     ; Turnoff syntax check
  817.     SET FLAG(9) OFF     ; ESC during compile
  818. ;
  819. ; ----- Start compilation
  820. ;
  821. Start:
  822.     WOPEN 10,1, 13,77 (contrast) ErrEsc
  823.     ATSAY 11, 3 (contrast) "Enter the source file name (with or without path/drive)."
  824.     ATSAY 12, 3 (contrast) "-> "
  825.     ATSAY 13,29 (contrast) " Press ESC to cancel "
  826. ;
  827. ;    Ask for a file name
  828. ;
  829.     ATGET 12, 7 (contrast) 60 S0    ; Get source file name
  830.     WCLOSE            ; Restore screen under
  831.     IF NULL S0
  832.        RETURN        ; End here
  833.        ENDIF
  834. ;
  835. ;    Attempt to open the given file
  836. ;
  837.     IF NOT ISFILE S0
  838.        S1 = S0
  839.        S0 = "File does not exist (or cannot be opened)"
  840.        GOSUB Error
  841.        GOTO Compile     ; Try again
  842.        ENDIF
  843.     FOPENI S0 TEXT        ; Try to open as text
  844.     IF FAILURE
  845.        S1 = S0
  846.        S0 = "Source file cannot be opened"
  847.        GOSUB Error
  848.        GOTO Compile     ; Try again
  849.        ENDIF
  850.     S18 = S0        ; Save open file name
  851. ;
  852. ;    Scan the file for 'section' names... if found, ask for a selection
  853. ;    On return, if FLAG(0) reset (off), file is positioned for I/O
  854. ;           Else, user ESC'd
  855. ;
  856.     GOSUB Select
  857.     IF FLAG(0)
  858.        RETURN
  859.        ENDIF
  860. ;
  861. ;    Open (and purge) the output file
  862. ;
  863.     IF NOT FLAG(8)        ; If not syntax check
  864.        FOPENO S19 BINARY
  865.        IF FAILURE
  866.           S1 = S0
  867.           S0 = "Target file cannot be opened"
  868.           GOSUB Error
  869.           RETURN        ; Error fatal to this subroutine
  870.           ENDIF
  871.        ENDIF
  872. ;
  873. ;    Set a display window for compilation
  874. ;
  875.     WOPEN 5,15 20,65 (contrast) CompESC
  876.     ATSAY 5,17 (contrast) " Remap compilation "
  877.     ATSAY 20,30 (contrast) " Press ESC to pause "
  878.     DWINDOW 6,17 19,63    ; Actual scrolling region
  879.     CLEAR            ; Clear the whole region
  880. ;
  881. ;    Other initialization
  882. ;
  883.     N99 = 0         ; # errors
  884.     N98 = 0         ; Output file size
  885.     SET FLAG(9) OFF     ; Escape during compile
  886. ;
  887. ; ***** Read a line and display it
  888. ;    N99 -----> Counts the # errors
  889. ;
  890. Loop:
  891.     READ S0 80 N0        ; Len read into N0
  892.     IF EOF
  893.        GOTO End_Compile
  894.        ENDIF
  895.     S1 = S0         ; Replicate
  896.     PRESERVE S1        ; Keep bangs and carets
  897.     MESS S1         ; Display the line (just as read)
  898. ;
  899. ;    Catch comments here
  900. ;
  901.     IF NULL S0
  902.        GOTO LOOP
  903.        ENDIF
  904.     LJ S0            ; Left justify
  905.     IF STRCMP S0(0:0) ";" or STRCMP S0(0:0) "*"
  906.        GOTO LOOP
  907.        ENDIF
  908. ;
  909. ;    Extract the keycode into S1
  910. ;
  911.     FIND S0 "=" N1          ; Find an '=' sign
  912.     S1 = S0(0:N1-1)     ; Extract keycode
  913.     LJ S1
  914.     IF EQ N1 0 or NULL S1    ; = in col 0, or empty keycode
  915.        MESS "*** Missing keycode ***"
  916.        INC N99        ; Count the error
  917.        GOTO Loop
  918.        ENDIF
  919. ;
  920. ;    The 2nd time we hit a section heading, (NAME = ...) make an EOF
  921. ;
  922.     IF FIND S1(0:3) "NAME"  ; Case insensitive test
  923.        IF ZERO N97        ; # NAME = lines found so far
  924.           GOTO End_Compile    ; pseudo EOF
  925.           ENDIF
  926.        DEC N97        ; Pass this one by, byt count it
  927.        GOTO Loop        ; Throw away 1st
  928.        ENDIF
  929. ;
  930. ;    Extract the operand into S2
  931. ;
  932.     S2 = S0(N1+1:79)    ; Extract operand
  933.     LJ S2
  934.     IF NULL S2        ; Empty assignment
  935.        MESS "*** Missing assignment ***"
  936.        INC N99        ; Count the error
  937.        GOTO Loop
  938.        ENDIF
  939. ;
  940. ;    Look at the keycode in S1
  941. ;
  942.     S0 = S1         ; Parameter passed
  943.     GOSUB Keycode
  944.     IF FLAG(0)
  945.        MESS "*** Invalid keycode ***"
  946.        INC N99        ; Count the error
  947.        GOTO Loop
  948.        ENDIF
  949.     S3 = S0         ; Keep converted value
  950.     N3 = N0         ; Keep length of conversion so far
  951. ;
  952. ;    Initialize the output operand
  953. ;
  954.     S4 = ""                 ; Nake it null
  955.     N4 = 0            ; Length so far
  956. ;
  957. ; ***** Now - begin handling the operand
  958. ;
  959. LOOP100:
  960.     LJ S2            ; Throw away leading blanks
  961.     IF NULL S2
  962.        GOTO LOOP300     ; When its null, end of operand
  963.        ENDIF
  964.  
  965.     IF STRCMP "," S2(0:0)   ; Look for a leading comma
  966.        S2 = S2(1:79)    ; Throw away comma
  967.        GOTO LOOP100     ; And continue
  968.        ENDIF
  969. ;
  970. ;    Catch quotes here
  971. ;
  972.     IF STRCMP "`"" S2(0:0)  ; Look for a leading double quote
  973.        GOTO LOOP200     ; Handle it specially in operand
  974.        ENDIF
  975. ;
  976. ;    ";" terminator allows comments in-line
  977. ;
  978.     IF STRCMP ";"  S2(0:0)  ; Look for a leading semi-colon
  979.        GOTO LOOP300     ; Treat as-if end of line
  980.        ENDIF
  981. ;
  982. ;    Parse out something
  983. ;
  984.     FIND S2 " " N5          ; Find position of next blank
  985.     FIND S2 "," N6          ; Find position of next comma
  986.     IF EQ N6 N5        ; Both -1 if neither found
  987.        S0 = S2        ; Neither a ' ' or ',' - use whole string
  988.        S2 = ""              ; Null remaining operand
  989.     ELSE
  990.        IF EQ N6 -1        ; use N5
  991.        ELSE
  992.           IF EQ N5 -1 or LT N6 N5
  993.          N5 = N6    ; Set N5 to smaller legit value
  994.          ENDIF
  995.           ENDIF
  996.        S0 = S2(0:N5-1)    ; Extract what we found
  997.        S2 = S2(N5+1:79)    ; And remove it from the string
  998.        ENDIF
  999. ;
  1000. ;    One keycode is an operand only... handle it
  1001. ;
  1002.     IF FIND S0(0:5) "Functn"; Special function
  1003.        ITOC 0 S4(N4)
  1004.        ITOC 0x80 S4(N4+1)    ; Made-up extended code for COM-AND
  1005.        N4 = N4+2
  1006.        GOTO LOOP100
  1007.        ENDIF
  1008. ;
  1009. ;    Test for a token
  1010. ;
  1011.     GOSUB Keycode
  1012.     IF FLAG(0)
  1013.        MESS "*** Invalid code in operand ***"
  1014.        INC N99        ; Count the error
  1015.        GOTO Loop
  1016.        ENDIF
  1017. ;
  1018. ;    Test for a circular definition
  1019. ;
  1020.     IF N0 eq 2 AND STRCMP S3(1) S0(1)
  1021.        MESS "*** Remap would be circular ***"
  1022.        INC N99        ; Count the error
  1023.        GOTO Loop
  1024.        ENDIF
  1025. ;
  1026. ;    Add the non-ascii key to the operand
  1027. ;
  1028.     CONCAT S4(N4) S0(0:N0-1); Concatenate converted string into S4
  1029.     N4 = N4+N0        ; Keep length of conversion so far
  1030.     GOTO LOOP100
  1031. ;
  1032. ; ***** Handle a quoted string in the operand here
  1033. ;
  1034. LOOP200:
  1035.     S2 = S2(1:79)        ; Eliminate leading char
  1036.     IF NULL S2        ; Missing terminating ""
  1037.        MESS "*** Invalid quoted string ***"
  1038.        INC N99        ; Count the error
  1039.        GOTO Loop
  1040.        ENDIF
  1041.  
  1042.     IF STRCMP S2(0:0) "`""  ; If we find a second ""
  1043.        S2 = S2(1:79)    ; .. Eliminate it
  1044.        GOTO LOOP100     ; .. and continue
  1045.        ENDIF
  1046.  
  1047.     IF STRCMP S2(0:0) "^^"
  1048.        S2 = S2(1:79)    ; Eliminate leading caret
  1049.        IF STRCMP S2(0:0) "^^"
  1050.           CONCAT S4(N4) "^^"; ^^ -> ^ in output
  1051.           N4 = N4+1     ; Keep length of conversion so far
  1052.           GOTO LOOP200
  1053.        ELSE
  1054.           S5 = S2(0:0)    ; Take just 1st char
  1055.           UPPER S5        ; Upper case it alone
  1056.           CTOI S5 N5
  1057.           ITOC (N5-64) S4(N4)
  1058.           N4 = N4+1     ; Keep length of conversion so far
  1059.           GOTO LOOP200
  1060.           ENDIF
  1061.        ENDIF
  1062.  
  1063.     IF STRCMP S2(0:0) "!!"  ; DOn't want STRCMP to collapse it
  1064.        IF STRCMP S2(1:1) "!!"
  1065.           S2 = S2(1:79)    ; Eliminate leading bang
  1066.           CONCAT S4(N4) "!!"; !! -> ! in output
  1067.           N4 = N4+1     ; Keep length of conversion so far
  1068.           GOTO LOOP200
  1069.        ELSE
  1070.           ITOC 13 S4(N4)    ; Else "!" -> C/r
  1071.           N4 = N4+1     ; Keep length of conversion so far
  1072.           GOTO LOOP200
  1073.           ENDIF
  1074.        ENDIF
  1075.  
  1076.     IF STRCMP S2(0:0) "``"
  1077.        S2 = S2(1:79)    ; Eliminate leading grave
  1078.        IF NULL S2        ; Ignore final grave...
  1079.           GOTO LOOP200
  1080.           ENDIF
  1081.        ENDIF
  1082.  
  1083.     CTOI S2 N5        ; Take char as-is
  1084.     ITOC N5 S4(N4)
  1085.     N4 = N4+1
  1086.     GOTO LOOP200
  1087. ;
  1088. ; ***** Look for an empty operand
  1089. ;    N3 -> The length of the keycode (1,2) in S3
  1090. ;    N4 -> The length of the operand       in S4
  1091. ;
  1092. LOOP300:
  1093.     IF LE N4 0
  1094.        MESS "*** Empty operand out ***"
  1095.        INC N99        ; Count the error
  1096.        GOTO Loop
  1097.        ENDIF
  1098. ;
  1099. ; ***** Write the remap to disk
  1100. ;
  1101.     N98 = N98+N3+1+N4    ; Track output file size
  1102.     IF LE N98 768        ; Do not write too much
  1103.        IF NOT FLAG(8)    ; IF table size OK, and not syntax
  1104.           ITOC N4 S5    ; Move len to a char string
  1105.           WRITE S3 N3    ; Write keycode
  1106.           WRITE S5 1    ; Write 1 byte length
  1107.           WRITE S4 N4    ; And write the operand
  1108.           ENDIF
  1109.     ELSE
  1110.        MESS "*** Output max size exceeded ***"
  1111.        INC N99        ; Count the error
  1112.        ENDIF
  1113.     GOTO Loop
  1114. ;
  1115. ;    End of compilation - clear the window limits and close output
  1116. ;
  1117. End_Compile:
  1118.     DWINDOW CLEAR        ; CLEAR THE display window
  1119.     FCLOSEO         ; CLose the output (OK if not open)
  1120.     FCLOSEI         ; CLose the input
  1121. ;
  1122. ;    Open a descriptive window
  1123. ;
  1124.     WOPEN 10,1, 14,77 (contrast) ErrEsc
  1125.     ATSAY 11, 3 (contrast) "The output file is "*N98*" bytes"
  1126.     ATSAY 12, 3 (contrast) "There were "*N99*" errors"
  1127.     IF GT N98 768
  1128.        ATSAY 13,3 (contrast) "Warning: ^GThe output file was truncated to the maximum allowed"
  1129.        ENDIF
  1130.     ATSAY 14,26 (contrast) " Press any key to continue "
  1131.     KEYGET S0        ; Wait for any key
  1132.     WCLOSE            ; Restore screen under
  1133. ;
  1134. ;    Drop the Final window and we're done
  1135. ;
  1136.     WCLOSE
  1137.     RETURN
  1138. ;
  1139. ; ----- Open a window and display a menu
  1140. ;
  1141. Window:
  1142.     WOPEN 0 ,10 19,70 (default)
  1143.     ATSAY 0 ,12 (default) " COM-AND Remapping "
  1144.     ATSAY 1 ,11 (default)  " COM-AND version 2.4 allows the keyboard to be remapped.   "
  1145.     ATSAY 2 ,11 (default)  " Any keystroke COM-AND can detect (it cannot detect all)   "
  1146.     ATSAY 3 ,11 (default)  " may be assigned to another key or keys.  Macros may be    "
  1147.     ATSAY 4 ,11 (default)  " created using this facility, as well as simple remaps.    "
  1148.  
  1149.     ATSAY 6 ,11 (default)  " Source text files are created indpendantly and compiled   "
  1150.     ATSAY 7 ,11 (default)  " with this script into the COM-AND.RMP file for use.       "
  1151.  
  1152.     ATSAY 8 ,10 (default) "├───────────────────────────────────────────────────────────┤"
  1153.     ATSAY 9  12 (default) "1) Compile source into a new remap"
  1154.     ATSAY 10 12 (default) "2) Syntax check a source file"
  1155.     ATSAY 11 12 (default) "3) Search for files (Alt-F)"
  1156.     ATSAY 12 12 (default) "4) Edit a file (you supply the editor)"
  1157.     ATSAY 13 12 (default) "5) Turn remap on (using current map)"
  1158.     ATSAY 14 12 (default) "6) Turn remap off"
  1159.     ATSAY 15,10 (default) "├───────────────────────────────────────────────────────────┤"
  1160.     ATSAY 16,12 (default) "Output: "*S19(0:48)
  1161.     ATSAY 17,10 (default) "├───────────────────────────────────────────────────────────┤"
  1162.     ATSAY 18,12 (default) "Select:"
  1163.     ATSAY 19 32 (default) " Press ESC to exit "
  1164.     RETURN
  1165.